(in-package :lilu-apropos)

;;;
;;; interactive apropos
;;;

(defparameter *command-options*
  (list '(:command-name-regex :regex "")
        '(:command-package-name-regex :regex "")
        '(:command-table-name-regex :regex "")))

(defclass command-iapropos (iapropos)
  ((command-table-iapropos :initform (make-instance 'command-table-iapropos)
                           :reader command-iapropos-command-table-iapropos))
  (:default-initargs
   :options *command-options*
   :sorting-symbol-p t
   :remove-duplicate-p nil
   :obj->symbol-fn #'climi::command-item-name
   :match-object-fn #'%command-iapropos-match-command-p)
  (:documentation "Interactive apropos class based on cl-ppcre and swank"))

(defun command-iapropos-set-option-values (iapropos &rest args
                                           &key reset-p command-name-regex
                                             command-table-name-regex)
  (declare (ignore command-name-regex command-table-name-regex))
  (apply #'iapropos-set-option-values iapropos :reset-p reset-p args))

(defmethod iapropos-update-search ((iapropos iapropos) changes)
  (with-slots (command-table-iapropos
               max-result-length
               result-overflow-p)
      iapropos
    (anaphora:awhen (assoc :command-table-name-regex changes)
      (command-table-iapropos-set-option-values command-table-iapropos :command-table-name-regex (third anaphora:it)))
    (let ((swank::*buffer-package* (find-package :common-lisp-user))
          (swank::*buffer-readtable* *readtable*)
          (out)
          (i 0)
          (cached-matching-command-tables (command-table-iapropos-matched-command-tables command-table-iapropos)))
      (setf result-overflow-p nil)
      (block iter
        (dolist (command-table cached-matching-command-tables)
          (dolist (command (alexandria:hash-table-values (climi::commands command-table)))
            (when (= i max-result-length)
              (setf out (remove-duplicates out))
              (setf i (length out))
              (when (= i max-result-length)
                (setf result-overflow-p t)
                (return-from iter)))
            (when (%command-iapropos-match-command-p iapropos command)
              (push command out)
              (incf i)))))
      out)))

(defgeneric command-iapropos-matched-commands (command-iapropos)
  (:documentation "Return the list of commands that match the specified criteria")
  (:method  ((command-iapropos command-iapropos))
    (with-slots (cached-matched-objects) command-iapropos
      cached-matched-objects)))

(defgeneric command-iapropos-matched-command-tables (command-iapropos)
  (:documentation "Return the list of command-tables that match the specified criteria")
  (:method ((command-iapropos command-iapropos))
    (with-slots (command-table-iapropos) command-iapropos
      (command-table-iapropos-matching-command-tables command-table-iapropos))))

(defun %command-iapropos-match-command-p (iapropos command)
  (with-slots (option-values cached-regexp-scanners bound-to) iapropos
    (and
     (when-option-regex (:command-name-regex cached-regexp-scanners)
       (cl-ppcre:scan scanner (symbol-name (climi::command-item-name command))))
     (when-option-regex (:command-package-name-regex cached-regexp-scanners)
       (when (symbol-package (climi::command-item-name command))
         (cl-ppcre:scan scanner (string (package-name (symbol-package
                                                       (climi::command-item-name command))))))))))

(defmethod iapropos-describe-object ((iapropos command-iapropos) command)
   (with-slots (option-values) iapropos
     (append
      (list :name (climi::command-item-name command)))))
